00100	C**** NEWMRK.F4 *****
00200	COPYRIGHT 1982 BY LELAND SMITH
00300	C************ READX, NEWMRK, ISNUM, DOIT, MORMRK, DASHES, CPYALL, CMDIN  *******
00400	
00500		SUBROUTINE READX
00600		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /ALF/INP(72)/SCM/V(78)
00700		EQUIVALENCE (V(2),V2)
00800	C****320	REREAD 2430,J,R2,RJQ
00900	C  ↑↑↑ 1/78
01000		DO 2 K=2,72
01100		IF(INP(K).NE.'<')GO TO 2
01200		DO 3 J=K,72
01300	3	INP(J)=' '
01400		GO TO 4
01500	2	CONTINUE
01600	C CATCH '<' -- WHICH = COMMENT FOR REST OF LINE
01700	4	CALL RREAD(INP,V)
01800		JA=V(1)
01900		R2=V2
02000		DO 1 K=1,20
02100	1	RJQ(K)=V(K+2)
02200		END
02300	
02400		FUNCTION ISNUM(M)
02500	C ISNUM=0 IF M=A NUMBER.  ASSUMES A DOT MEANS DECIMAL POINT
02600		ISNUM=-1
02700		IF(M.EQ.'.')ISNUM=0
02800		IF(M.GE.'0'.AND.M.LE.'9')ISNUM=0 
02900		END
03000	
03100		SUBROUTINE NEWMRK(VX)
03200		DIMENSION VX(1)
03300		COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JJ,NN,MM
03400		1 /SC/A,B,C,D,E,NNN /ALF/INP(1) /MX/MX,MZ
03405		DO 40 J=1,72
03410		M=INP(J)
03412	C CHANGES /C 7 12/ TO /C 7:12/  ETC.
03415		IF(M.EQ.'*')GO TO 41
03420		IF(M.NE.'C'.AND.M.NE.'O')GO TO 40
03421		IF(INP(J+1).EQ.'R')GO TO 40
03422		NN=-1
03423		N2=J+1
03425	44	  DO 42 MM=N2,72
03426		  JJ=INP(MM)
03427		  IF(JJ.EQ.'/')GO TO 40
03428		  IF(JJ.EQ.'*'.OR.JJ.EQ.';')GO TO 41
03430		  IF(ISNUM(JJ).NE.0)GO TO 42
03432	C NOW FOUND A NUMBER. NEXT LOOK FOR SPACE.
03435		    DO 43 MX=MM+1,72
03440		    IF(INP(MX).NE.' '.AND.INP(MX).NE.':')GO TO 43
03445		    IF(NN.LT.0)INP(MX)=':'
03447	C INSERT : AFTER EVERY OTHER NUMBER.
03450		    NN=-NN
03455		    N2=MX+1
03460		    GO TO 44
03465	43	    CONTINUE
03470	42	  CONTINUE
03475	40	CONTINUE
03500	41	J=1
03600	34	J=J+1
03700	35	IF(ISNUM(INP(J)).NE.0)GO TO 30
03800			DO 31 MM=J+1,72
03900			M=INP(MM)
04000			IF(M.EQ.'/')GO TO 30
04100			IF(M.EQ.';')GO TO 30
04200			IF(M.EQ.'*')GO TO 30
04300			IF(M.NE.' ')GO TO 31
04400	C NOW FOUND SPACE AFTER NUMB.
04500				DO 32 J=MM+1,72
04600				M=INP(J)
04700				IF(M.EQ.' ')GO TO 32
04800				IF(ISNUM(M).NE.0)GO TO 30
04900	C FOUND SOMETHING, BUT NOT NUMB.
05000				INP(MM)=','
05100	C  FOUND NUMB, SO PUT IN COMMA
05200			
05300				IF(J.LT.72)GO TO 35
05400				GO TO 33
05500	32			CONTINUE
05600			GO TO 33
05700	31		CONTINUE
05800		GO TO 33
05975	30	IF(J.LT.72)GO TO 34
06000	33	MX=0
06100	C MX IS FLAG FOR LINE TOO LONG IN NEW FORMAT
06200		J=0
06300		MM=0
06400	10	JJ=0
06500		NN=0
06600		N2=0
06700	1	J=J+1
06800		IF(J.GT.72)GO TO 20
06900	C JUMP IF DONE
07000		M=INP(J)
07100	CURRENT CHARACTER
07200		IF(M.EQ.'-')GO TO 21
07300	C  '-' NEEDED FOR "C-" (DECRESC. SIGN)
07400		IF(M.LT.'A'.OR.M.GT.'Z')GO TO 2
07500	C JUMP IF A LETTER IS NOT FOUND
07600	21	JJ=JJ+1
07700		N(JJ)=M
07800		GO TO 1
07900	2	IF(M.EQ.' ')GO TO 1
08000	5	NN=NN+1
08100		JN(NN)=M
08200	C SAVE THE NUMBER CHARS.
08300	6	J=J+1
08400		M=INP(J)
08500	CC	IF(M.GE.'0'.AND.M.LE.'9')GO TO 5
08600	CC	IF(M.EQ.'.')GO TO 5
08700		IF(ISNUM(M).EQ.0)GO TO 5
08800	CXX	IF(M.NE.':')GO TO 22
08900		IF(M.NE.'!')GO TO 22
09000		M='-'
09100	C NEG. N2 WILL =TOTAL OF ITEMS STARTING WITH N1( /S 12!3/=/S 12:14/)
09200		NN=NN+1
09300		JN(NN)=' '
09400		GO TO 5
09500	22	IF(M.EQ.' ')GO TO 6
09600		IF(M.NE.':')GO TO 7
09700	C NOW A SEQUENCE OF ITEMS
09800		M=' '
09900		GO TO 5
10000	7	IF(M.NE.',')GO TO 8
10100	C NOW A SINGLE ITEM
10200		CALL DOIT
10300		NN=0
10400	C ITEM OR ITEMS NOW FINISHED
10500		GO TO 6
10600	8	IF(M.NE.'/')GO TO 11
10700		CALL DOIT
10800		GO TO 10
10900	11	IF(M.NE.';'.AND.M.NE.'*')GO TO 6
11000	C JUMP IF UNKNOWN CHAR.
11100		CALL DOIT
11200		KN(MM)=M
11300		IF(MM.LE.71)GO TO 20
11400	C SKIP IF REVISED LINE NOT TOO LONG
11500		MZ=MM
11600		DO 201 MM=71,1,-1
11700	201	IF(KN(MM).EQ.'/')GO TO 202
11800	202	MX=MM+1
11900	C POINTS TO START OF REMAINDER OF TOO-LONG LINE
12000		INP(72)=0
12100	20	CALL MORMRK(1,MM,VX)
12200		END
12300	
12400		SUBROUTINE DOIT
12500		COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JJ,NN,MM
12600		IF(N(1).NE.'C'.AND.N(1).NE.'O')GO TO 3
12700	CATCHES /C 5-7/C- 11.2-13.5/O 1-21/  ETC.
12800		IF(N2.EQ.'R')GO TO 3
12900	C JUMP IF "CR"  FOR WORD "CRESC."
13000		DO 4 K=1,NN
13100		MM=MM+1
13200		JX=JN(K)
13300		KN(MM)=JX
13400	4	IF(JX.EQ.' ')GO TO 5
13500	C  FIRST NUMBER COMPLETED
13600	5	DO 6 JX=1,JJ
13700		MM=MM+1
13800	6	KN(MM)=N(JX)
13900	CODE LETTER INSERTED
14000		MM=MM+1
14100		KN(MM)=' '
14200		DO 7 JX=K+1,NN
14300	C NOW PUT IN LAST NUMBER
14400		MM=MM+1
14500	7	KN(MM)=JN(JX)
14600		GO TO 8
14700	3	DO 1 K=1,NN
14800		MM=MM+1
14900	1	KN(MM)=JN(K)
15000		MM=MM+1
15100		KN(MM)=' '
15200		DO 2 K=1,JJ
15300		MM=MM+1
15400	2	KN(MM)=N(K)
15500	C NOW PUT IN THE CODE WORD
15600	8	MM=MM+1
15700		KN(MM)='/'
15800	CLOSE OFF THE ITEM
15900		END
16000	
16100	CC	SUBROUTINE MORMRK(VX)
16200		SUBROUTINE MORMRK(MA,MB,VX)
16300		DIMENSION VX(1)
16400		COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JO,NN,MM
16500		1 /SC/A,B,C,D,E,NNN /ALF/INP(1) /MX/MX,MZ
16600	CC	K=0
16700		MM=0
16800	C GET THE REST OF A TOO-LONG LINE
16900		DO 1 K=MA,MB
17000	CC	DO 1 J=MX,MZ
17100		MM=MM+1
17200	CC	K=K+1
17300	1	INP(MM)=KN(K)
17400	CC1	INP(K)=KN(J)
17500	CC	MM=K
17600		DO 13 K=MM+1,72
17700	13	INP(K)=' '
17800		IF(INP(MM).EQ.'*')INP(72)='*'
17900	C LINE ENDS WITH * OR ;
18000	C NOW GO FIX UP THE VX ARRAY.
18100	3	CALL RREAD(INP,VX)
18200		DO 23 K=1,50
18300		X=VX(K)
18400		IF(X.GT.0)Z=X
18500	C SAVE THE LAST POSITIVE NUM.
18600		IF(X.LT.0)VX(K)=-X+Z-1.
18700	C /S 17:5/=/S 17-21/ I.E. 5 NOTES STACCATO, STARTING WITH 17
18800	23	CONTINUE
18900	999	NNN=VX(1)
19000	CC	MX=0
19100		END
19200	 
19300		SUBROUTINE DASHES(IX,R2,RD)
19400	CC	SUBROUTINE DASHES(IX,R2,R3,R4,R5,R6)
19500		DIMENSION RD(1)
19600	C R3=RD(1) R4=RD(2) . . . R7=RD(5)  R8=RD(6) . . .
19700	      COMMON /XRN/RN(3000)/PTR/KWDS(350)/DL/K22 /STF/RSTFAC(0/7),RSTJ2
19800		DATA RDX/2.3/,RDZ/0.5/,BSIZE/3.17/
19900	C FIND CLOSEST WORD TO LFT AND RIGHT OF R3    BSIZE=BASIC SIZE OF 1 LETTER
20000		IF(RD(8).EQ.0)RETURN
20100	C P10 MUST NOT!! BE ZERO.
20200		B=9999.0
20300		A=-B
20400		LFT=0
20500		JRT=0
20600		DO 1 K=1,IX
20700	C GETS CODE NUM. J=PTR TO THAT ITEM.
20800		J=KWDS(K)
20900	5	IF(RN(J+1).NE.16)GO TO 1
21000	C FOUND WORD
21100		IF(RN(J+2).NE.R2)GO TO 1
21200	C NOW ON THIS STAFF
21300		IF(ABS(RN(J+4)-RD(2)).GT.4.)GO TO 1
21400	C  P4 OF DASH MUST BE WITHIN +4, -4 VERTICAL STEPS OF WORD ON EITHER SIDE.
21500	7	RR3=RN(J+3)
21600		IF(RR3.GT.RD(1))GO TO 3
21700		IF(RR3.LE.A)GO TO 1
21800		A=RR3
21900		LFT=J
22000	C A WILL BE POS. OF FRONT OF LEFT GROUP.  LFT IS PNTR.
22100		GO TO 1
22200	3	IF(RR3.GE.B)GO TO 1
22300		B=RR3
22400		JRT=J
22500	1	CONTINUE
22600	C WON'T WORK WITH OVERLAPPING WORDS!!!!
22700	
22800		J=LFT
22900		IF(LFT.NE.0)GO TO 2
23000		IF(JRT.EQ.0)RETURN
23100		J=JRT
23200	2	SZ=RN(J+5)
23300		R5=SZ*RSTJ2
23400	C R=REAL SIZE FACTOR FOR SPACE     RN(LFT+9) IS WIDTH OF GROUP TO LEFT.
23500		RP=R5*RN(J+9)+A
23600		IF(RP.LT.0)RP=3.0
23700	C RP=RIGHT SIDE OF LEFT CHAR. STRING.
23800		R3=RP
23900		IF(B.GT.201)B=201.
24000		R6=B-R5*BSIZE
24100	CC	RR6=R6
24200		IF(R3.LT.0)R3=4.
24300	CX	IF(R6.GT.201)R6=201.
24400	C 3.17 IS BASIC WIDTH OF MOST LETTERS
24500		IF(RD(5).EQ.0)GO TO 4
24600	C SKIP IF R7=0 (NO SHORT DASHES)
24700		A=B-RP-BSIZE*R5
24800	C DIST. FROM END OF LFT WD TO START OF RT WD. (LESS 2 CHAR SPACES)
24900	8	B=IFIX(A/(25.*R5))+1.
25000	C  B=NUMB OF DASHES
25100	9	RR3=2.5*SZ
25200	C RR3 IS DASH WIDTH
25300		A=(A-B*2.5*R5)/(B+1.)
25400	C A=SPACE BETWEEN DASHES  (P9)  IF SPACE IS TOO SMALL MAKE LRG DASH.
25500	CCC	IF(A.LT.RDZ)GO TO 11
25600		R3=RP+A
25700	10	R6=R6-RDZ
25800	CC10	R6=R3+(RR3+A)*B-RR3-RDZ
25900		RD(6)=RR3
26000		RD(7)=A/RSTJ2
26100	C P9(SPACE BETWEEN DASHES) REAL SIZE IS P9*RSTJ2
26200	CCC	GO TO 4
26300	CCC11	RD(5)=0
26400	4	RD(2)=RN(J+4)+1.0-R5*0.5
26500	C  SET HEIGHT OF DASH   CONSIDERS LETTER SIZE AND STAFF SIZE
26600		RD(3)=RD(2)
26700	C WAS R5=R4
26800		RD(1)=R3
26900		IF(R6-R3.LT.0.2)R6=R3+0.2
27000		RD(4)=R6
27100		END
27200	
27300		SUBROUTINE CPYALL
27400	C COPIES ALL OF ONE CODE NUM. FROM ONE STAFF TO ALL OTHER ACTIVE STAVES.
27500		COMMON  /LIMIT/LIMIT,ITEM,L,I /PTR/KWDS(1) /POSI/S(8),JJ2
27600		COMMON R2,J,K,N,RJQ(3),R6,RJ(16),NO,JQ(10),NN,LL  /XRN/RN(1) 
27700		JJ2=ITEM+1
27800		J=ITEM
27900	C NOW FIND WHICH STAVES CURRENTLY ACTIVE
28000		DO 1 K=0,7
28100	1	JQ(K)=0
28200		DO 2 K=1,J
28300		L=KWDS(K)
28400	2	JQ(IFIX(RN(L+2)))=-1
28500		JQ(IFIX(R2))=0
28600	C BUT OMIT SOURCE STAFF
28700		DO 3 K=1,J
28800		L=KWDS(K)
28900		IF(RTLINE(L).LT.0)GO TO 3
29000	C ON RIGHT LINE?
29100		IF(OUTLIM(L,3).LT.0)GO TO 3
29200	C  WITHIN GIVEN LFT AND RT LIMITS?
29300	9	IF(RN(L+1).NE.R6)GO TO 3
29400	C FOUND A SOURCE ITEM (CODE# IN R11).  NOW PUT IT ON ALL OTHER STAVES.
29500	7	NN=RN(L)+3
29600	C NUMBER OF NEW WORDS ADDED TO ARRAY
29700		DO 8 N=0,7
29800		IF(JQ(N).EQ.0)GO TO 8
29900	4	CALL LOOP(0,NN,1,I,L,RN)
30000	5	ITEM=ITEM+1
30100		LL=KWDS(ITEM)
30200		RN(LL+2)=N
30300	C PUT IN CORRECT STAFF NUM.
30400	6	I=I+NN
30500	C UPDATE XRN ARRAY COUNTER AND POINTER ARRAY.
30600		KWDS(ITEM+1)=I
30700	8	CONTINUE
30800	3	CONTINUE
30900	CC	JJ2=ITEM+1
31000		END
31100	
31200		SUBROUTINE CMDIN
31300	C SAVES INPUT LINES WHEN 1ST CHAR. IS :    EACH STRING=23 CHARS.
31400	C OUTPUTS SAVED LINES WHEN 1ST CHAR. IS ;
31500		COMMON /ALF/INP(72)
31600		DIMENSION J(72)
31700		EQUIVALENCE (I1,INP),(I2,INP(2)),(I3,INP(3))
31800		IF(I1.EQ.';')GO TO 11
31900	C JUMP TO GET BACK COMMAND 1, 2 OR 3 (; ;; ;;;)
32000	   	N=2
32100		L=1
32200		LL=1
32300	10	NN=N+22
32400		DO 2 K=N,NN
32500		M=INP(K)
32600		IF(M.EQ.':')GO TO 3
32700		J(L)=M
32800	2	L=L+1
32900		IF(K.EQ.NN)GO TO 6
33000	3	DO 5 KK=K,NN
33100		J(L)=' '
33200	5	L=L+1
33300	4	IF(M.NE.':')GO TO 6
33400	C 3 COMMANDS CAN BE GIVEN ON ONE LINE, EACH STARTS WITH :
33500	C  THE 1ST ONE WILL BE ACTIVATED IMMEDIATELY, OR BY TYPING ;
33600	C THE 2ND AND 3RD ARE ACTIVATED BY TYPING ;; OR ;;;
33700	C NO ERROR TRAP FOR MORE THEN 3 COLONS
33800		LL=LL+23
33900		L=LL
34000		N=K+1
34100		GO TO 10
34200	6	N=1
34300	9	NN=N+19
34400		L=0
34500		DO 7 K=N,NN
34600		L=L+1
34700	7	INP(L)=J(K)
34800		DO 8 K=24,72
34900	C CLEAR REST OF INP ARRAY
35000	8	INP(K)=' '
35100		RETURN
35200	11	N=1
35300		IF(I2.EQ.';')N=24
35400		IF(I3.EQ.';')N=47
35500		GO TO 9
35600	C  GO GET BACK COMMAND 1, 2 OR 3  (; ;; ;;;)
35700		END